home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TCYBER25 / CYGRAPH.ZIP / CYGRAPH.PAS < prev   
Pascal/Delphi Source File  |  1994-10-20  |  39KB  |  1,569 lines

  1. {
  2. Turbo Vision CyberTools 2.5
  3. (C) 1994 Steve Goldsmith
  4. All Rights Reserved
  5.  
  6. CyberGraph application shows how to use graphics primitives in text mode.
  7. Configuration stream compatible with CyberEdit 2.5.
  8.  
  9. Borland Pascal 7.x or Turbo Pascal 7.x and Turbo Vision 2.x are required to
  10. compile.
  11.  
  12. Set IDE directories to
  13.  
  14. \BP\UNITS;
  15. \BP\EXAMPLES\DOS\TVDEMO;
  16. \BP\EXAMPLES\DOS\TVFM;
  17.  
  18. These path names are BP 7.x defaults.  If you changed any of these then use
  19. the correct paths in Options|Directories...  See APP.INC for global compiler
  20. switches.
  21. }
  22.  
  23. program CyberGraph;
  24.  
  25. {$I APP.INC}
  26. {$X+}
  27.  
  28. uses
  29.  
  30.   Dos,                           {bp units}
  31.   Memory, Drivers, Objects,      {tv units}
  32.   Views, Menus, Dialogs,
  33.   App, MsgBox, StdDlg, ColorSel,
  34.   Gadgets, HelpFile,             {tvdemo units}
  35.   ViewText,                      {tvfm units}
  36.   CRHelp, CRCmds,                {cybertools units}
  37. {$IFDEF UseDLL}
  38.   CyberAPI,
  39. {$ELSE}
  40.   VGA,
  41. {$ENDIF}
  42.   VGACGFil, PCX,
  43.   CommDlgs, TVStr;
  44.  
  45.  
  46. const
  47.  
  48.   appDocName  = 'CYBER.DOC';   {doc file name}
  49.   appCfgName  = 'CYEDIT.CFG';  {config stream file name}
  50.   appHelpName = 'CRHELP.HLP';  {help file name}
  51.   appExeName  = 'CYGRAPH.EXE'; {name used to locate .exe for older dos}
  52.   appCfgHeaderLen = 10;        {header used by config stream}
  53.   appCfgHeader : string[appCfgHeaderLen] = 'CYBEREDIT'#26;
  54.   appViewDocBuf = 8192;        {buffer size for viewing doc file}
  55.  
  56.   appChrWidth8  = $0001;       {screen options}
  57.   appPageMode   = $0002;
  58.   app8Colors    = $0004;
  59.   appScrOpts    = $0007;       {mask of just screen options}
  60.   appWinResize  = $0008;       {graphic window resized}
  61.   appStarField  = $0010;       {animate star field}
  62.   appSkipIdle   = $0020;       {skip idle toggle}
  63.   appHelpInUse  = $8000;       {used by help system}
  64.  
  65.   appFadeInc   = 8;            {fade in/out increment}
  66.   appMaxStar   = 99;           {last star}
  67.  
  68.   CSysColor = #$00#$00#$00;    {app palette additions for tv system stuff}
  69.   CSysPal   = #137#138#139;
  70.  
  71. type
  72.  
  73.   AppStarArr = array [0..appMaxStar,0..2] of integer;
  74.  
  75.   TCyberGraph = object (TApplication)
  76.     FontTable1,
  77.     FontTable2,
  78.     FirstChr,
  79.     LastChr : byte;
  80.     AppOptions,
  81.     PageOfs,
  82.     DefChrHeight,
  83.     WinSizeData,
  84.     GraphWinX,
  85.     GraphWinY : word;
  86.     Page : pointer;
  87.     DefFont : vgaChrTablePtr;
  88.     DacPalette : vgaPalette;
  89.     StarArr : AppStarArr;
  90.     ScrData : ScrOptsData;
  91.     Clock : PClockView;
  92.     Heap : PHeapView;
  93.     constructor Init;
  94.     destructor Done; virtual;
  95.     procedure SetCustomScreen;
  96.     procedure FlipPage;
  97.     procedure ClearDeskTop;
  98.     procedure Idle; virtual;
  99.     procedure AboutBox;
  100.     procedure LoadFontTable (ChrData : pointer;
  101.                              ChrTable, ChrHeight :byte;
  102.                              StartChr, NumChrs : word);
  103.     function SaveFontTable (ChrTable, ChrHeight :byte;
  104.                             StartChr, NumChrs : word) : vgaChrTablePtr;
  105.     procedure ClearGraphWin;
  106.     procedure GraphicsWin (T : string);
  107.     procedure RestoreDesktop (F : PathStr);
  108.     procedure SaveDeskTop (F : PathStr);
  109.     procedure GetEvent (var Event : TEvent); virtual;
  110.     function GetPalette : PPalette; virtual;
  111.     procedure HandleEvent (var Event : TEvent); virtual;
  112.     procedure InitDeskTop; virtual;
  113.     procedure InitMenuBar; virtual;
  114.     procedure InitStatusLine; virtual;
  115.     procedure OutOfMemory; virtual;
  116.     procedure LoadDesktop (var S : TStream);
  117.     procedure StoreDesktop (var S : TStream);
  118.   end;
  119.  
  120. {
  121. Initilize TV app.
  122. }
  123.  
  124. constructor TCyberGraph.Init;
  125.  
  126. var
  127.  
  128.   R :TRect;
  129.  
  130. begin
  131.   LowMemSize := 512;    {8192 byte safety pool}
  132.   inherited Init;
  133.   RegisterObjects;      {register stuff for stream access}
  134.   RegisterViews;
  135.   RegisterMenus;
  136.   RegisterDialogs;
  137.   RegisterApp;
  138.   RegisterHelpFile;
  139.  
  140.   GetExtent (R);   {gadgets included with tvdemo}
  141.   R.A.Y := R.B.Y-1;
  142.   R.B.X := R.B.X-1;
  143.   R.A.X := R.B.X-8;
  144.   Heap := New (PHeapView,Init(R));
  145.   Heap^.GrowMode := gfGrowAll;
  146.   Insert (Heap);
  147.  
  148.   GetExtent (R);
  149.   R.B.Y := R.A.Y+1;
  150.   R.B.X := R.B.X-1;
  151.   R.A.X := R.B.X-8;
  152.   Clock := New (PClockView,Init (R));
  153.   Insert (Clock);
  154.  
  155.   RestoreDesktop (appCfgName); {load config stream}
  156.   GraphWinX := 32;             {x = 32*8 = 256 pixels}
  157.   GraphWinY := 8;              {y = 8*16 = 128 pixels}
  158.   WinSizeData := 1;            {256 x 128 button value}
  159.   AboutBox;
  160.   ClearGraphWin;               {put graphic window on screen}
  161.   Randomize
  162. end;
  163.  
  164. {
  165. Done TV app.
  166. }
  167.  
  168. destructor TCyberGraph.Done;
  169.  
  170. begin
  171.   if DefFont <> nil then      {dispose default font}
  172.     FreeMem (DefFont,vgaMaxChrs*DefChrHeight);
  173.   FadeOutDAC (appFadeInc);    {fade to black}
  174.   SetVideoMode (StartUpMode); {this resets all the custom stuff with bios}
  175.   inherited Done
  176. end;
  177.  
  178. {
  179. Sets screen page if not not flipping, 8 or 16 color mode, 8 or 9 pixel width,
  180. font map, DAC palette and mouse mask.
  181. }
  182.  
  183. procedure TCyberGraph.SetCustomScreen;
  184.  
  185. begin
  186.   HideMouse;
  187.   if AppOptions and appPageMode = 0 then
  188.     SetPage (vgaPageOfsLoc[0]); {screen page 0 for non page flipping displays}
  189.   if AppOptions and app8Colors = app8Colors then
  190.     SetAttrCont (vgaAttrCPEnable,$07)  {use 8 colors}
  191.   else
  192.     SetAttrCont (vgaAttrCPEnable,$0f); {use 16 colors}
  193.   if AppOptions and appChrWidth8 = appChrWidth8 then
  194.   begin
  195.     if IsChrWidth9 then
  196.       SetChrWidth8 {640 x 400 screen}
  197.   end
  198.   else
  199.   begin
  200.     if not IsChrWidth9 then
  201.       SetChrWidth9 {720 x 400 screen}
  202.   end;
  203.   FontMapSelect (vgaChrTableMap1[FontTable1],
  204.   vgaChrTableMap2[FontTable2]);    {select font tables}
  205.   SetDACBlock (@DacPalette,0,256); {set 256 color palette}
  206.   MouseTextMask ($ffff,$f700);     {set mouse mask for both fonts}
  207.   ShowMouse
  208. end;
  209.  
  210. {
  211. Copy screen page 0 to new non-visiable page and flip to new page.
  212. }
  213.  
  214. procedure TCyberGraph.FlipPage;
  215.  
  216. begin
  217.   CopyScrMem (ScreenBuffer,Page,vgaScrSize25);
  218.   SetPage (PageOfs);
  219.   if PageOfs = vgaPageOfsLoc[1] then
  220.   begin
  221.     PageOfs := vgaPageOfsLoc[2];
  222.     Page := vgaPageLoc[2]
  223.   end
  224.   else
  225.   begin
  226.     PageOfs := vgaPageOfsLoc[1];
  227.     Page := vgaPageLoc[1]
  228.   end;
  229.   WaitVertSync {wait for vga vert sync before drawing anything}
  230. end;
  231.  
  232. {
  233. Remove all closeable windows from desk top.
  234. }
  235.  
  236. procedure TCyberGraph.ClearDeskTop;
  237.  
  238. procedure CloseDlg (P : PView); far;
  239.  
  240. begin
  241.   Message (P,evCommand,cmClose,nil)
  242. end;
  243.  
  244. begin
  245.   Desktop^.ForEach (@CloseDlg)
  246. end;
  247.  
  248. {
  249. Handle app's idle time processing.
  250. }
  251.  
  252. procedure TCyberGraph.Idle;
  253.  
  254. {return true if any view on desk top is tileable}
  255.  
  256. function IsTileable (P : PView) : boolean; far;
  257.  
  258. begin
  259.   IsTileable := (P^.Options and ofTileable <> 0) and
  260.   (P^.State and sfVisible <> 0)
  261. end;
  262.  
  263. {
  264. Update star field.  Disable interrupts instead HideMouse/ShowMouse which
  265. causes mouse cursor to flicker.
  266. }
  267.  
  268. procedure UpdateStars;
  269.  
  270. var
  271.  
  272.   I, X, Y : integer;
  273.  
  274. begin
  275.   if AppOptions and appSkipIdle = 0 then
  276.   begin
  277.     X := GraphWinX*8;            {max x pixel}
  278.     Y := GraphWinY*DefChrHeight; {max y pixel}
  279.     asm
  280.       pushf
  281.       cli {disable interrupts}
  282.     end;
  283.     AccessFontMem;
  284.     for I := 0 to appMaxStar do
  285.     begin
  286.       SetTablePix (StarArr[I,0],StarArr[I,1],GraphWinX,DefChrHeight,
  287.       vgaChrTableLoc[FontTable2],true); {erase old pix}
  288.       if StarArr[I,0]+StarArr[I,2] < X then
  289.         Inc (StarArr[I,0],StarArr[I,2])
  290.       else
  291.       begin
  292.         StarArr[I,0] := 0;
  293.         StarArr[I,1] := Random (Y)
  294.       end;
  295.       SetTablePix (StarArr[I,0],StarArr[I,1],GraphWinX,DefChrHeight,
  296.       vgaChrTableLoc[FontTable2],false) {plot new pix}
  297.     end;
  298.     AccessScreenMem;
  299.     asm
  300.       popf {enable interrupts}
  301.     end;
  302.     AppOptions := AppOptions or appSkipIdle       {skip next idle}
  303.   end
  304.   else
  305.     AppOptions := AppOptions and not appSkipIdle  {process next idle}
  306. end;
  307.  
  308. begin
  309.   inherited Idle;
  310.   Clock^.Update; {update tvdemo gadgets}
  311.   Heap^.Update;
  312.   if Desktop^.Current <> nil then              {see if anything is}
  313.   begin                                        {on the desk top}
  314.     EnableCommands ([cmCloseAll]);
  315.     if Desktop^.FirstThat (@IsTileable) <> nil then {see if any tileable}
  316.       EnableCommands ([cmTile,cmCascade])           {windows are on the}
  317.     else                                            {desk top}
  318.       DisableCommands ([cmTile,cmCascade])
  319.   end
  320.   else
  321.     DisableCommands ([cmCloseAll,cmTile,cmCascade]);
  322.   if ((Desktop^.Current <> nil) and
  323.   (Desktop^.Current^.State and sfModal = sfModal)) or
  324.   (AppOptions and appHelpInUse = appHelpInUse) then    {see if modal dialog}
  325.     DisableCommands ([cmQuit])                         {is on the desk top}
  326.   else
  327.     EnableCommands ([cmQuit]);
  328.   if AppOptions and appStarField <> 0 then
  329.     UpdateStars;  {update star field}
  330.   if AppOptions and appPageMode <> 0 then
  331.     FlipPage  {flip page each idle cycle}
  332. end;
  333.  
  334. {
  335. Display info about app.
  336. }
  337.  
  338. procedure TCyberGraph.AboutBox;
  339.  
  340. begin
  341.   HelpCtx := hcAbout;
  342.   MessageBox(
  343.     #3'Turbo Vision CyberTools 2.5'#13+
  344.     #3'(C) 1994 Steve Goldsmith'#13+
  345. {$IFDEF DPMI}
  346.     #3'CyberGraph DPMI',
  347. {$ELSE}
  348.     #3'CyberGraph REAL',
  349. {$ENDIF}
  350.     nil, mfInformation or mfOKButton);
  351.   HelpCtx := hcNoContext
  352. end;
  353.  
  354. {
  355. Load font table from system RAM.
  356. }
  357.  
  358. procedure TCyberGraph.LoadFontTable (ChrData : pointer;
  359.                                     ChrTable, ChrHeight :byte;
  360.                                     StartChr, NumChrs : word);
  361.  
  362. begin
  363.   HideMouse;
  364.   AccessFontMem;
  365.   SetRamTable (StartChr,NumChrs,ChrHeight,ChrData,vgaChrTableLoc[ChrTable]);
  366.   AccessScreenMem;
  367.   ShowMouse
  368. end;
  369.  
  370. {
  371. Save font table from video RAM.
  372. }
  373.  
  374. function TCyberGraph.SaveFontTable (ChrTable, ChrHeight :byte;
  375.                                    StartChr, NumChrs : word) : vgaChrTablePtr;
  376.  
  377. begin
  378.   HideMouse;
  379.   AccessFontMem;
  380.   SaveFontTable :=
  381.   GetRamTable (StartChr,NumChrs,ChrHeight,vgaChrTableLoc [ChrTable]);
  382.   AccessScreenMem;
  383.   ShowMouse
  384. end;
  385.  
  386. procedure TCyberGraph.ClearGraphWin;
  387.  
  388. var
  389.  
  390.   I : integer;
  391.   ChrTablePtr : vgaChrTablePtr;
  392.  
  393. begin
  394.   ChrTablePtr := vgaChrTableLoc[FontTable2];
  395.   HideMouse;
  396.   AccessFontMem;
  397.   for I := 0 to vgaChrTableSize-1 do {clear font table mem}
  398.     ChrTablePtr^[I] := 0;
  399.   AccessScreenMem;
  400.   ShowMouse;
  401.   GraphicsWin ('')                   {clear title}
  402. end;
  403.  
  404. {
  405. Text mode graphics window.  Set app options to appWinResize to dispose current
  406. graphics window and create one with new size.
  407. }
  408.  
  409. procedure TCyberGraph.GraphicsWin (T : string);
  410.  
  411. var
  412.  
  413.   P : PChrSetDlg;
  414.  
  415. function IsThere (P : PView) : Boolean; far;
  416.  
  417. begin {see if view is a chr set dialog}
  418.   IsThere := (TypeOf (P^) = TypeOf (TChrSetDlg))
  419. end;
  420.  
  421. begin
  422.   PView (P) := Desktop^.FirstThat (@IsThere);
  423.   if P <> nil then {if on screen then close}
  424.   begin
  425.     if AppOptions and appWinResize <> 0 then {window resized}
  426.     begin
  427.       PChrSetDlg (P)^.Close;
  428.       AppOptions := AppOptions and not appWinResize;
  429.       P := New (PChrSetDlg,Init (T,GraphWinX,GraphWinY));
  430.       P^.Options := P^.Options or ofCentered;
  431.       P^.HelpCtx := hcGraphicsWindow;
  432.       InsertWindow (P)
  433.     end
  434.     else
  435.     begin
  436.       if PChrSetDlg (P)^.Title <> nil then
  437.         DisposeStr (PChrSetDlg (P)^.Title);
  438.       PChrSetDlg (P)^.Title := NewStr (T);
  439.       PChrSetDlg (P)^.Frame^.DrawView;
  440.       PChrSetDlg (P)^.MakeFirst
  441.     end
  442.   end
  443.   else
  444.   begin
  445.     P := New (PChrSetDlg,Init (T,GraphWinX,GraphWinY));
  446.     P^.Options := P^.Options or ofCentered;
  447.     P^.HelpCtx := hcGraphicsWindow;
  448.     InsertWindow (P)
  449.   end
  450. end;
  451.  
  452. {
  453. Restore desk top stream.
  454. }
  455.  
  456. procedure TCyberGraph.RestoreDesktop (F : PathStr);
  457.  
  458. var
  459.  
  460.   I : byte;
  461.   S : PStream;
  462.   Signature : string[appCfgHeaderLen];
  463.  
  464. begin
  465.   S := New (PBufStream,Init (F,stOpenRead,1024));
  466.   if LowMemory then OutOfMemory
  467.   else
  468.     if S^.Status <> stOk then
  469.     begin
  470.       MessageBox (#3'Unable to open file.',nil,mfOkButton+mfError)
  471.     end
  472.     else
  473.     begin
  474.       Signature[0] := Char (appCfgHeaderLen);
  475.       S^.Read (Signature[1],appCfgHeaderLen);
  476.       if Signature = appCfgHeader then {see if signature is right}
  477.       begin
  478.         S^.Read (AppOptions,SizeOf (AppOptions)); {read data from stream}
  479.         S^.Read (FontTable1,SizeOf (FontTable1));
  480.         S^.Read (FontTable2,SizeOf (FontTable2));
  481.         S^.Read (FirstChr,SizeOf (FirstChr));
  482.         S^.Read (LastChr,SizeOf (LastChr));
  483.         S^.Read (DacPalette,SizeOf (DacPalette));
  484.  
  485.         if DefFont = nil then
  486.           DefFont := MemAlloc (DefChrHeight*vgaMaxChrs);
  487.         HideMouse; {no screen writes during font mem access}
  488.         AccessFontMem;
  489.         for I := 0 to 7 do
  490.         begin
  491.           S^.Read (DefFont^,DefChrHeight*vgaMaxChrs);
  492.           SetRamTable (0,vgaMaxChrs,DefChrHeight,DefFont,vgaChrTableLoc[I])
  493.         end;
  494.         AccessScreenMem;
  495.         ShowMouse;
  496.  
  497.         LoadDesktop (S^);
  498.         LoadIndexes (S^);
  499.         ShadowAttr := GetColor (137);   {tv shadow color}
  500.         SysColorAttr := (GetColor (138) shl 8) or
  501.         GetColor (138);                 {tv system error color}
  502.         ErrorAttr := GetColor (139);    {tv palette index error color}
  503.         Application^.ReDraw; {draw app with new config}
  504.         if DefFont <> nil then
  505.         begin
  506.           FreeMem (DefFont,DefChrHeight*vgaMaxChrs);
  507.           DefFont := SaveFontTable (FontTable1,DefChrHeight,0,vgaMaxChrs)
  508.         end;
  509.         SetCustomScreen;
  510.         if S^.Status <> stOk then
  511.           MessageBox (#3'Stream error.',nil,mfOkButton+mfError);
  512.       end
  513.       else
  514.         MessageBox (#3'Invalid configuration format.',nil,mfOkButton+mfError)
  515.     end;
  516.   Dispose (S,Done)
  517. end;
  518.  
  519. {
  520. Save desk top stream.
  521. }
  522.  
  523. procedure TCyberGraph.SaveDesktop (F : PathStr);
  524.  
  525. var
  526.  
  527.   I : byte;
  528.   CfgFile : File;
  529.   S : PStream;
  530.   SFont : vgaChrTablePtr;
  531.  
  532. begin
  533.   S := New(PBufStream,Init (F,stCreate,1024));
  534.   if not LowMemory and (S^.Status = stOk) then
  535.   begin
  536.     S^.Write (appCfgHeader[1],appCfgHeaderLen); {write stream data}
  537.     S^.Write (AppOptions,SizeOf (AppOptions));
  538.     S^.Write (FontTable1,SizeOf (FontTable1));
  539.     S^.Write (FontTable2,SizeOf (FontTable2));
  540.     S^.Write (FirstChr,SizeOf (FirstChr));
  541.     S^.Write (LastChr,SizeOf (LastChr));
  542.     GetDACBlock (@DacPalette,0,256);
  543.     S^.Write(DacPalette,SizeOf (DacPalette));
  544.  
  545.     HideMouse; {no screen write during font mem access}
  546.     AccessFontMem;
  547.     for I := 0 to 7 do {save all 8 vga font tables}
  548.     begin
  549.       SFont := GetRamTable (0,vgaMaxChrs,DefChrHeight,vgaChrTableLoc[I]);
  550.       S^.Write (SFont^,DefChrHeight*vgaMaxChrs);
  551.       if SFont <> nil then
  552.         FreeMem (SFont,DefChrHeight*vgaMaxChrs)
  553.     end;
  554.     AccessScreenMem;
  555.     ShowMouse;
  556.  
  557.     StoreDesktop (S^);
  558.     StoreIndexes (S^);
  559.     if S^.Status <> stOk then
  560.     begin {if stream error then delete file}
  561.       MessageBox (#3'Could not create stream.',nil,mfOkButton+mfError);
  562.       Dispose (S,Done);
  563.       Assign (CfgFile,F);
  564.       {$I-} Erase (CfgFile) {$I+};
  565.       Exit
  566.     end
  567.   end;
  568.   Dispose (S,Done)
  569. end;
  570.  
  571. {
  572. Intercept cmHelp to display help even when views are in modal state.
  573. }
  574.  
  575. procedure TCyberGraph.GetEvent (var Event : TEvent);
  576.  
  577. function CalcHelpName : PathStr;
  578.  
  579. var
  580.  
  581.   EXEName : PathStr;
  582.   Dir : DirStr;
  583.   Name : NameStr;
  584.   Ext : ExtStr;
  585.  
  586. begin
  587.   if Lo (DosVersion) >= 3 then
  588.     EXEName := ParamStr (0)
  589.   else
  590.     EXEName := FSearch (appExeName, GetEnv ('PATH'));
  591.   FSplit (EXEName, Dir, Name, Ext);
  592.   if Dir[Length (Dir)] = '\' then
  593.     Dec (Dir[0]);
  594.   CalcHelpName := FSearch (appHelpName, Dir);
  595. end;
  596.  
  597. var
  598.  
  599.   W : PWindow;
  600.   HFile : PHelpFile;
  601.   HelpStrm : PDosStream;
  602.  
  603. begin
  604.   inherited GetEvent (Event);
  605.   case Event.What of
  606.     evCommand:
  607.       if (Event.Command = cmHelp) and (AppOptions and appHelpInUse = 0) then
  608.       begin {process help command if not in use}
  609.         AppOptions := AppOptions or appHelpInUse; {help's in use}
  610.         HelpStrm := New (PDosStream, Init (CalcHelpName, stOpenRead));
  611.         HFile := New (PHelpFile, Init (HelpStrm));
  612.         if HelpStrm^.Status <> stOk then
  613.         begin
  614.           MessageBox (#3'Could not open help file.', nil, mfError + mfOkButton);
  615.           Dispose (HFile, Done);
  616.         end
  617.         else
  618.         begin
  619.           W := New (PHelpWindow,Init (HFile, GetHelpCtx));
  620.           if ValidView (W) <> nil then
  621.           begin
  622.             DisableCommands ([cmHelp]);
  623.             ExecView (W);
  624.             Dispose (W, Done);
  625.             EnableCommands ([cmHelp])
  626.           end;
  627.           ClearEvent (Event)
  628.         end;
  629.         AppOptions := AppOptions and not appHelpInUse
  630.       end;
  631.     evMouseDown:
  632.       if Event.Buttons <> 1 then
  633.         Event.What := evNothing
  634.   end
  635. end;
  636.  
  637. {
  638. Get custom app palette.
  639. }
  640.  
  641. function TCyberGraph.GetPalette: PPalette;
  642.  
  643. const
  644.  
  645.   CNewColor = CAppColor+CHelpColor+CCharColor+CSysColor;
  646.   CNewBlackWhite = CAppBlackWhite+CHelpBlackWhite+CCharColor+CSysColor;
  647.   CNewMonochrome = CAppMonochrome+CHelpMonochrome+CCharColor+CSysColor;
  648.   P: array[apColor..apMonochrome] of string[Length (CNewColor)] =
  649.   (CNewColor, CNewBlackWhite, CNewMonochrome);
  650.  
  651. begin {add additional entries to the normal application palettes}
  652.   GetPalette := @P[AppPalette];
  653. end;
  654.  
  655. {
  656. Process app events.
  657. }
  658.  
  659. procedure TCyberGraph.HandleEvent (var Event: TEvent);
  660.  
  661. {
  662. Load DOC file.
  663. }
  664.  
  665. procedure ViewTextFile (FileName : PathStr);
  666.  
  667. var
  668.  
  669.   T : PTextWindow;
  670.   R : TRect;
  671.  
  672. begin
  673.   GetExtent (R);
  674.   R.Grow (-5,-4);
  675.   T := New(PTextWindow, Init(R, FileName));
  676.   T^.Options := T^.Options or ofCentered;
  677.   T^.Palette := wpGrayWindow;
  678.   T^.HelpCtx := hcViewDoc;
  679.   InsertWindow (T)
  680. end;
  681.  
  682. {
  683. Load CGF file and store in table.
  684. }
  685.  
  686. procedure LoadChrFile (F : PathStr; ChrTbl : byte);
  687.  
  688. var
  689.  
  690.   ChrFile : TChrGenFile;
  691.  
  692. begin
  693.   ChrFile.Init;
  694.   ChrFile.OpenRead (F);
  695.   if (ChrFile.IoError = 0) and
  696.   (ChrFile.Header.Height = DefChrHeight) then
  697.   begin
  698.     ChrFile.ReadChrTable;
  699.     LoadFontTable (
  700.     ChrFile.ChrTablePtr,ChrTbl,ChrFile.Header.Height,
  701.     ChrFile.Header.StartChr,ChrFile.Header.TotalChrs)
  702.   end
  703.   else
  704.     MessageBox (#3'Problem reading font file.',nil,mfOkButton+mfError);
  705.   ChrFile.FreeChrTable;
  706.   ChrFile.Done
  707. end;
  708.  
  709. {
  710. Save CGF file from table.
  711. }
  712.  
  713. procedure SaveChrFile (F : PathStr);
  714.  
  715. var
  716.  
  717.   ChrFile : TChrGenFile;
  718.  
  719. begin
  720.   ChrFile.Init;
  721.   HideMouse;
  722.   AccessFontMem;
  723.   ChrFile.GetFontTable (FontTable2,
  724.   FirstChr,(LastChr-FirstChr)+1,DefChrHeight);
  725.   AccessScreenMem;
  726.   ShowMouse;
  727.   ChrFile.OpenWrite (F);
  728.   if ChrFile.IoError = 0 then
  729.     ChrFile.WriteChrTable
  730.   else
  731.     MessageBox (#3'Problem writing font file.',nil,mfOkButton+mfError);
  732.   ChrFile.FreeChrTable;
  733.   ChrFile.Done
  734. end;
  735.  
  736. {
  737. Tree window.
  738. }
  739.  
  740. procedure TreeWindow (T : string; FMask : PathStr; ACmd : word);
  741.  
  742. var
  743.  
  744.   W : PDirWindow;
  745.   Drive : PathStr;
  746.  
  747. begin
  748.   GetDir (0,Drive); {open tree in default dir}
  749.   W := New (PDirWindow,Init (T,Drive,FMask,ACmd));
  750.   W^.HelpCtx := hcTreeWindow;
  751.   InsertWindow (W)
  752. end;
  753.  
  754. {
  755. Return focused file name from dir tree window.  If the extension param is not
  756. null then that extension is used.
  757. }
  758.  
  759. function TreeFileName (TW : PDirWindow; EStr : PathStr; ReadFlag : boolean) : PathStr;
  760.  
  761. var
  762.  
  763.   F : file;
  764.   FName : PathStr;
  765.  
  766. begin
  767.   FName := UpCaseStr (TW^.FocDirName+TW^.NameLine^.Data^);
  768.   if (EStr <> '') and (FName[byte (FName[0])] <> '\') then {force extension}
  769.     FName := AddExtStr (FName,EStr);
  770.   if ReadFlag then
  771.     TreeFileName := FName
  772.   else
  773.   begin
  774.     Assign (F,FName);
  775.     {$I-} Reset (F); {$I+}
  776.     if IoResult = 0 then {see if file exists before writes}
  777.     begin
  778.       {$I-} Close (F); {$I+}
  779.       if MessageBox (FName+' already exists.  Erase and continue?',
  780.       nil,mfConfirmation or mfYesNoCancel) = cmYes then
  781.         TreeFileName := FName
  782.       else
  783.         TreeFileName := ''
  784.     end
  785.     else
  786.       TreeFileName := FName {doesn't exist, so return name}
  787.   end
  788. end;
  789.  
  790. {
  791. Load .CGF file.
  792. }
  793.  
  794. procedure LoadFontFile (TW : PDirWindow);
  795.  
  796. var
  797.  
  798.   F : PathStr;
  799.  
  800. begin
  801.   F := TreeFileName (TW,'CGF',true);
  802.   if F <> '' then
  803.     LoadChrFile (F,FontTable2)
  804. end;
  805.  
  806. {
  807. Save .CGF file.
  808. }
  809.  
  810. procedure SaveFontFile (TW : PDirWindow);
  811.  
  812. var
  813.  
  814.   F : PathStr;
  815.  
  816. begin
  817.   F := TreeFileName (TW,'CGF',false);
  818.   if F <> '' then
  819.     SaveChrFile (F)
  820. end;
  821.  
  822. {
  823. Decode and view 2 color PCX file up to 640 X 480.  Actual viewing area is
  824. determined by graphics window size.
  825. }
  826.  
  827. procedure LoadPCXFile (TW : PDirWindow);
  828.  
  829. var
  830.  
  831.   F : PathStr;
  832.   Decode : TPCXToChrTable;
  833.  
  834. begin
  835.   F := TreeFileName (TW,'PCX',true);
  836.   if F <> '' then
  837.   begin
  838.     HideMouse; {no screen writes during font mem access}
  839.     Decode.Init (F,GraphWinX,GraphWinY,
  840.     DefChrHeight,vgaChrTableLoc[FontTable2]);
  841.     if Decode.ReadError = 0 then
  842.     begin
  843.       GraphicsWin ('');
  844.       ShowMouse
  845.     end
  846.     else
  847.     begin
  848.       ShowMouse;
  849.       MessageBox (#3'Problem reading PCX file.',nil,mfOkButton+mfError)
  850.     end;
  851.     Decode.Done
  852.   end
  853. end;
  854.  
  855. {
  856. Encode graphics window and save as 2 color PCX file.
  857. }
  858.  
  859. procedure SavePCXFile (TW : PDirWindow);
  860.  
  861. var
  862.  
  863.   F : PathStr;
  864.   Encode : TChrTableToPCX;
  865.  
  866. begin
  867.   F := TreeFileName (TW,'PCX',false);
  868.   if F <> '' then
  869.   begin
  870.     HideMouse; {no screen writes during font mem access}
  871.     Encode.Init (F,GraphWinX,GraphWinY,DefChrHeight,vgaChrTableLoc[FontTable2]);
  872.     if Encode.WriteError <> 0 then
  873.     begin
  874.       ShowMouse;
  875.       MessageBox (#3'Problem writing PCX file.',nil,mfOkButton+mfError);
  876.     end
  877.     else
  878.       ShowMouse;
  879.     Encode.Done
  880.   end
  881. end;
  882.  
  883. {
  884. Restore default font loaded by config.
  885. }
  886.  
  887. procedure RestoreDefFont;
  888.  
  889. begin
  890.   if (DefFont <> nil) and
  891.   (DefChrHeight = BiosGetChrHeight) then
  892.     LoadFontTable (DefFont,FontTable1,DefChrHeight,0,vgaMaxChrs)
  893. end;
  894.  
  895. {
  896. Set custom screen options.
  897. }
  898.  
  899. procedure ScreenOptions;
  900.  
  901. var
  902.  
  903.   D : PScrOptsDlg;
  904.  
  905. begin
  906.   with ScrData do
  907.   begin
  908.     SMode := AppOptions and appScrOpts; {use only screen options}
  909.     FontMapVal (GetSeqCont (vgaSeqChrMapSel),byte (FntTbl1),byte (FntTbl2));
  910.     FChr := IntToStr (FirstChr);
  911.     LChr := IntToStr (LastChr);
  912.     D := New (PScrOptsDlg,Init);
  913.     D^.Options := D^.Options or ofCentered;
  914.     D^.HelpCtx := hcScreenDialog;
  915.     if ExecuteDialog (D,@ScrData) <> cmCancel then
  916.     begin
  917.       AppOptions := (AppOptions and not appScrOpts)
  918.       or SMode; {clear all scr opts bits and set bits returned from dialog}
  919.       FontTable1 := FntTbl1;
  920.       FontTable2 := FntTbl2;
  921.       FirstChr := StrToInt (FChr);
  922.       LastChr := StrToInt (LChr);
  923.       SetCustomScreen {set screen with new settings}
  924.     end
  925.   end
  926. end;
  927.  
  928. {
  929. Set custom TV color palette.
  930. }
  931.  
  932. procedure Colors;
  933.  
  934. {custom color items}
  935. function DlgColorItems (Palette: Word; const Next: PColorItem) : PColorItem;
  936.  
  937. const
  938.  
  939.   COffset : array[dpBlueDialog..dpGrayDialog] of Byte = (64, 96, 32);
  940.  
  941. var
  942.  
  943.   Offset : Byte;
  944.  
  945. begin
  946.   Offset := COffset[Palette];
  947.   DlgColorItems :=
  948.     ColorItem ('Frame passive',     Offset,
  949.     ColorItem ('Frame active',      Offset + 1,
  950.     ColorItem ('Frame icons',       Offset + 2,
  951.     ColorItem ('Scroll bar page',   Offset + 3,
  952.     ColorItem ('Scroll bar icons',  Offset + 4,
  953.     ColorItem ('Static text',       Offset + 5,
  954.  
  955.     ColorItem ('Label normal',      Offset + 6,
  956.     ColorItem ('Label selected',    Offset + 7,
  957.     ColorItem ('Label shortcut',    Offset + 8,
  958.  
  959.     ColorItem ('Button normal',     Offset + 9,
  960.     ColorItem ('Button default',    Offset + 10,
  961.     ColorItem ('Button selected',   Offset + 11,
  962.     ColorItem ('Button disabled',   Offset + 12,
  963.     ColorItem ('Button shortcut',   Offset + 13,
  964.     ColorItem ('Button shadow',     Offset + 14,
  965.  
  966.     ColorItem ('Cluster normal',    Offset + 15,
  967.     ColorItem ('Cluster selected',  Offset + 16,
  968.     ColorItem ('Cluster shortcut',  Offset + 17,
  969.  
  970.     ColorItem ('Input normal',      Offset + 18,
  971.     ColorItem ('Input selected',    Offset + 19,
  972.     ColorItem ('Input arrow',       Offset + 20,
  973.  
  974.     ColorItem ('History button',    Offset + 21,
  975.     ColorItem ('History sides',     Offset + 22,
  976.     ColorItem ('History bar page',  Offset + 23,
  977.     ColorItem ('History bar icons', Offset + 24,
  978.  
  979.     ColorItem ('List normal',       Offset + 25,
  980.     ColorItem ('List focused',      Offset + 26,
  981.     ColorItem ('List selected',     Offset + 27,
  982.     ColorItem ('List divider',      Offset + 28,
  983.  
  984.     ColorItem('Information pane',  Offset + 29,
  985.     Next))))))))))))))))))))))))))))));
  986. end;
  987.  
  988. function HelpColorItems(const Next: PColorItem): PColorItem;
  989.  
  990. begin
  991.   HelpColorItems :=
  992.     ColorItem ('Frame passive',     128,
  993.     ColorItem ('Frame active',      129,
  994.     ColorItem ('Frame icons',       130,
  995.     ColorItem ('Scroll bar page',   131,
  996.     ColorItem ('Scroll bar icons',  132,
  997.     ColorItem ('Normal text',       133,
  998.     ColorItem ('Key word',          134,
  999.     ColorItem ('Select key word',   135,
  1000.     Next))))))))
  1001. end;
  1002.  
  1003. function CharColorItems (const Next: PColorItem) : PColorItem;
  1004.  
  1005. begin
  1006.   CharColorItems :=
  1007.     ColorItem ('Bit map', 136,
  1008.     Next)
  1009. end;
  1010.  
  1011. function SysColorItems (const Next: PColorItem) : PColorItem;
  1012.  
  1013. begin
  1014.   SysColorItems :=
  1015.     ColorItem ('Shadow',       137,
  1016.     ColorItem ('System error', 138,
  1017.     ColorItem ('Index error',  139,
  1018.     Next)))
  1019. end;
  1020.  
  1021. var
  1022.  
  1023.   D : PColorDialog;
  1024.  
  1025. begin
  1026.   D := New (PColorDialog,Init ('',
  1027.   ColorGroup ('Desktop',     DesktopColorItems(nil),
  1028.   ColorGroup ('Menus',       MenuColorItems(nil),
  1029.   ColorGroup ('Gray Windows',WindowColorItems(wpGrayWindow,nil),
  1030.   ColorGroup ('Blue Windows',WindowColorItems(wpBlueWindow,nil),
  1031.   ColorGroup ('Cyan Windows',WindowColorItems(wpCyanWindow,nil),
  1032.   ColorGroup ('Gray Dialogs',DlgColorItems(dpGrayDialog,nil),
  1033.   ColorGroup ('Blue Dialogs',DlgColorItems(dpBlueDialog,nil),
  1034.   ColorGroup ('Cyan Dialogs',DlgColorItems(dpCyanDialog,nil),
  1035.   ColorGroup ('Help',        HelpColorItems(nil),
  1036.   ColorGroup ('Graphics',    CharColorItems(nil),
  1037.   ColorGroup ('System',      SysColorItems(nil),
  1038.   nil)))))))))))));
  1039.   D^.HelpCtx := hcColorDialog;
  1040.   if ExecuteDialog (D,Application^.GetPalette) <> cmCancel then
  1041.   begin
  1042.     DoneMemory; {dispose all group buffers}
  1043.     ReDraw;     {redraw application with new palette}
  1044.     ShadowAttr := GetColor (137);   {tv shadow color}
  1045.     SysColorAttr := (GetColor (138) shl 8) or
  1046.     GetColor (138);                 {tv system error color}
  1047.     ErrorAttr := GetColor (139)     {tv palette index error color}
  1048.   end
  1049. end;
  1050.  
  1051. {
  1052. Adjust 16 text colors at DAC level.
  1053. }
  1054.  
  1055. procedure AdjustPalette;
  1056.  
  1057. var
  1058.  
  1059.   D : PPalDlg;
  1060.  
  1061. begin
  1062.   D := New (PPalDlg,Init);
  1063.   D^.Options := D^.Options or ofCentered;
  1064.   D^.HelpCtx := hcPaletteDialog;
  1065.   if ExecuteDialog (D,nil) <> cmCancel then
  1066.     GetDACBlock (@DacPalette,0,256)
  1067. end;
  1068.  
  1069. {
  1070. Set graphics window size matrix.
  1071. }
  1072.  
  1073. procedure GraphWinSize;
  1074.  
  1075. var
  1076.  
  1077.   D : PWinSizeDlg;
  1078.  
  1079. begin
  1080.   D := New (PWinSizeDlg,Init);
  1081.   D^.Options := D^.Options or ofCentered;
  1082.   D^.HelpCtx := hcSizeDialog;
  1083.   if ExecuteDialog (D,@WinSizeData) <> cmCancel then
  1084.   begin
  1085.     case WinSizeData of
  1086.       0 :
  1087.       begin
  1088.         GraphWinX := 16;
  1089.         GraphWinY := 16
  1090.       end;
  1091.       1 :
  1092.       begin
  1093.         GraphWinX := 32;
  1094.         GraphWinY := 8
  1095.       end;
  1096.       2 :
  1097.       begin
  1098.         GraphWinX := 64;
  1099.         GraphWinY := 4
  1100.       end
  1101.     end;
  1102.     AppOptions := (AppOptions or appWinResize) and not appStarField;
  1103.     ClearGraphWin
  1104.   end
  1105. end;
  1106.  
  1107. {
  1108. Load .CFG file.
  1109. }
  1110.  
  1111. procedure LoadConfigFile (TW : PDirWindow);
  1112.  
  1113. var
  1114.  
  1115.   F : PathStr;
  1116.  
  1117. begin
  1118.   F := TreeFileName (TW,'CFG',true);
  1119.   if F <> '' then
  1120.     RestoreDeskTop (F)
  1121. end;
  1122.  
  1123. {
  1124. Save .CFG file.
  1125. }
  1126.  
  1127. procedure SaveConfigFile (TW : PDirWindow);
  1128.  
  1129. var
  1130.  
  1131.   F : PathStr;
  1132.  
  1133. begin
  1134.   F := TreeFileName (TW,'CFG',false);
  1135.   if F <> '' then
  1136.     SaveDeskTop (F)
  1137. end;
  1138.  
  1139. {
  1140. Draw lines and size to graphics window.
  1141. }
  1142.  
  1143. procedure Lines;
  1144.  
  1145. var
  1146.  
  1147.   I, LineX, LineY, LineInc : integer;
  1148.  
  1149. begin
  1150.   LineX := GraphWinX*8;
  1151.   LineY := GraphWinY*DefChrHeight;
  1152.   LineInc := LineX div 16;
  1153.   GraphicsWin ('Lines');
  1154.   HideMouse;
  1155.   AccessFontMem;
  1156.   for I := 0 to 15 do
  1157.   begin
  1158.     DrawTableLine (0,0,I*LineInc,LineY-1,
  1159.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true);
  1160.     DrawTableLine (LineX-1,0,LineX-I*LineInc-1,LineY-1,
  1161.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true);
  1162.   end;
  1163.   AccessScreenMem;
  1164.   ShowMouse
  1165. end;
  1166.  
  1167. {
  1168. Draw ellipses and size to graphics window.
  1169. }
  1170.  
  1171. procedure Ellipses;
  1172.  
  1173. var
  1174.  
  1175.   I, CX, CY, EX, EY, XInc, YInc : integer;
  1176.  
  1177. begin
  1178.   EX := GraphWinX*8;
  1179.   EY := GraphWinY*DefChrHeight;
  1180.   CX := EX div 2;
  1181.   CY := EY div 2;
  1182.   XInc := EX div 32;
  1183.   YInc := EY div 32;
  1184.   GraphicsWin ('Ellipses');
  1185.   HideMouse;
  1186.   AccessFontMem;
  1187.   for I := 1 to 15 do
  1188.   begin
  1189.     DrawTableEllipse (CX,CY,I*XInc,I*YInc,
  1190.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true)
  1191.   end;
  1192.   AccessScreenMem;
  1193.   ShowMouse
  1194. end;
  1195.  
  1196. {
  1197. Generic rectangle routine for graphics window.
  1198. }
  1199.  
  1200. procedure DrawTableRect (X1,Y1,X2,Y2 : integer; PixOn : boolean);
  1201.  
  1202. begin
  1203.   DrawTableLine (X1,Y1,X2,Y1,
  1204.   GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],PixOn);
  1205.   DrawTableLine (X1,Y2,X2,Y2,
  1206.   GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],PixOn);
  1207.   DrawTableLine (X1,Y1,X1,Y2,
  1208.   GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],PixOn);
  1209.   DrawTableLine (X2,Y1,X2,Y2,
  1210.   GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],PixOn);
  1211. end;
  1212.  
  1213. {
  1214. Draw rectangles and size to graphics window.
  1215. }
  1216.  
  1217. procedure Rectangles;
  1218.  
  1219. var
  1220.  
  1221.   I, RecX, RecY, RecXInc, RecYInc : integer;
  1222.  
  1223.  
  1224. begin
  1225.   RecX := GraphWinX*8;
  1226.   RecY := GraphWinY*DefChrHeight;
  1227.   RecXInc := RecX div 32;
  1228.   RecYInc := RecY div 32;
  1229.   GraphicsWin ('Rectangles');
  1230.   HideMouse;
  1231.   AccessFontMem;
  1232.   for I := 0 to 15 do
  1233.     DrawTableRect (I*RecXInc,I*RecYInc,
  1234.     RecX-I*RecXInc-1,RecY-I*RecYInc-1,true);
  1235.   AccessScreenMem;
  1236.   ShowMouse
  1237. end;
  1238.  
  1239. {
  1240. Draw grid (graph paper) in graphics window for X,Y line plots.
  1241. }
  1242.  
  1243. procedure Grid (X, Y : integer);
  1244.  
  1245. var
  1246.  
  1247.   I, PlotsX, PlotsY, LineX, LineY, XInc, YInc : integer;
  1248.  
  1249. begin
  1250.   LineX := GraphWinX*8;
  1251.   LineY := GraphWinY*DefChrHeight;
  1252.   XInc := LineX div X;
  1253.   YInc := LineY div Y;
  1254.   PlotsX := LineX div XInc;
  1255.   PlotsY := LineY div YInc;
  1256.   HideMouse;
  1257.   AccessFontMem;
  1258.   for I := 1 to PlotsY do
  1259.   begin
  1260.     DrawTableLine (0,I*YInc,LineX-1,I*YInc,
  1261.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true);
  1262.   end;
  1263.   for I := 1 to PlotsX do
  1264.   begin
  1265.     DrawTableLine (I*XInc,0,I*XInc,LineY-1,
  1266.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true);
  1267.   end;
  1268.   AccessScreenMem;
  1269.   ShowMouse
  1270. end;
  1271.  
  1272. {
  1273. Draw random X,Y graph with random grid size.
  1274. }
  1275.  
  1276. procedure LineGraph;
  1277.  
  1278. var
  1279.  
  1280.   I, Plots, LineX, LineY, XInc, X, Y, X1, Y1, X2, Y2 : integer;
  1281.  
  1282. begin
  1283.   LineX := GraphWinX*8;
  1284.   LineY := GraphWinY*DefChrHeight;
  1285.   X := Random (LineX div 10)+5;
  1286.   Y := Random (LineY div 10)+5;
  1287.   XInc := LineX div X;
  1288.   Plots := LineX div XInc;
  1289.   GraphicsWin ('Graph');
  1290.   Grid (X,Y);
  1291.   HideMouse;
  1292.   AccessFontMem;
  1293.   X1 := 0;
  1294.   Y1 := Random (LineY);
  1295.   for I := 1 to Plots do
  1296.   begin
  1297.     X2 := X1+XInc;
  1298.     Y2 := Random (LineY);
  1299.     DrawTableLine (X1,Y1,X2,Y2,
  1300.     GraphWinX,DefChrHeight,vgaChrTableLoc[FontTable2],true);
  1301.     X1 := X2;
  1302.     Y1 := Y2
  1303.   end;
  1304.   AccessScreenMem;
  1305.   ShowMouse
  1306. end;
  1307.  
  1308. {
  1309. Horzizontal star field scroll.
  1310. }
  1311.  
  1312. procedure StarField;
  1313.  
  1314. var
  1315.  
  1316.   I, X, Y : integer;
  1317.   ChrTablePtr : vgaChrTablePtr;
  1318.  
  1319. begin
  1320.   if AppOptions and appStarField = 0 then
  1321.   begin
  1322.     ChrTablePtr := vgaChrTableLoc[FontTable2];
  1323.     HideMouse;
  1324.     AccessFontMem;
  1325.     for I := 0 to vgaChrTableSize-1 do {fill font table mem}
  1326.       ChrTablePtr^[I] := $ff;
  1327.     AccessScreenMem;
  1328.     ShowMouse;
  1329.     GraphicsWin ('Stars');
  1330.     X := GraphWinX*8;
  1331.     Y := GraphWinY*DefChrHeight;
  1332.     for I := 0 to appMaxStar do {initilize stars}
  1333.     begin
  1334.       StarArr [I,0] := Random (X);
  1335.       StarArr [I,1] := Random (Y);
  1336.       StarArr [I,2] := Random (4)+1
  1337.     end;
  1338.     AppOptions := AppOptions or appStarField
  1339.   end
  1340.   else
  1341.     AppOptions := AppOptions and not appStarField
  1342. end;
  1343.  
  1344. {
  1345. Force all oftileable windows to top.
  1346. }
  1347.  
  1348. procedure TileableOnTop (P : PView); far;
  1349.  
  1350. begin
  1351.   if (P^.Options and ofTileable = ofTileable) then
  1352.     P^.MakeFirst
  1353. end;
  1354.  
  1355. begin
  1356.   if (Event.What = evCommand) and
  1357.   ((Event.Command = cmCascade) or
  1358.   (Event.Command = cmTile)) then {seperate oftileable windows from nontileable ones}
  1359.     Desktop^.ForEach (@TileableOnTop);
  1360.   inherited HandleEvent (Event);
  1361.   case Event.What of
  1362.     evCommand:
  1363.       begin
  1364.         case Event.Command of {process commands}
  1365.           cmLoadFont    : TreeWindow ('Load Font File','*.CGF',cmLoadFont);
  1366.           cmSaveFont    : TreeWindow ('Save Font File','*.CGF',cmSaveFont);
  1367.           cmLoadPCX     : TreeWindow ('Load PCX File','*.PCX',cmLoadPCX);
  1368.           cmSavePCX     : TreeWindow ('Save PCX File','*.PCX',cmSavePCX);
  1369.           cmSaveConfig  : TreeWindow ('Save Config Stream','*.CFG',cmSaveConfig);
  1370.           cmLoadConfig  : TreeWindow ('Load Config Stream','*.CFG',cmLoadConfig);
  1371.           cmViewDoc     : ViewTextFile (appDocName);
  1372.           cmAbout       : AboutBox;
  1373.           cmCloseAll    : ClearDeskTop;
  1374.           cmRestoreDef  : RestoreDefFont;
  1375.           cmScreenOpts  : ScreenOptions;
  1376.           cmColors      : Colors;
  1377.           cmAdjPal      : AdjustPalette;
  1378.           cmLines       : Lines;
  1379.           cmEllipses    : Ellipses;
  1380.           cmRectangles  : Rectangles;
  1381.           cmLineGraph   : LineGraph;
  1382.           cmClrGraphWin : ClearGraphWin;
  1383.           cmWinSize     : GraphWinSize;
  1384.           cmStarField   : StarField
  1385.         else
  1386.           Exit
  1387.         end
  1388.       end;
  1389.     evBroadcast :
  1390.     begin
  1391.       case Event.Command of {process broadcasts}
  1392.         cmLoadFont    : LoadFontFile (PDirWindow (Event.InfoPtr));
  1393.         cmSaveFont    : SaveFontFIle (PDirWindow (Event.InfoPtr));
  1394.         cmLoadPCX     : LoadPCXFile (PDirWindow (Event.InfoPtr));
  1395.         cmSavePCX     : SavePCXFile(PDirWindow (Event.InfoPtr));
  1396.         cmSaveConfig  : SaveConfigFile (PDirWindow (Event.InfoPtr));
  1397.         cmLoadConfig  : LoadConfigFile (PDirWindow (Event.InfoPtr))
  1398.       else
  1399.         Exit
  1400.       end;
  1401.         ClearEvent (Event)
  1402.       end
  1403.   end
  1404. end;
  1405.  
  1406. {
  1407. Assign desk top pattern char, page locations, set default char height from
  1408. bios and save current DAC palette.
  1409. }
  1410.  
  1411. procedure TCyberGraph.InitDeskTop;
  1412.  
  1413. begin
  1414.   SetScreenMode (smCO80);              {make sure 80x25 active}
  1415.   inherited InitDeskTop;
  1416.   DeskTop^.Background^.Pattern := '▒'; {new wall paper}
  1417.   Page := vgaPageLoc[1];
  1418.   PageOfs := vgaPageOfsLoc[1];
  1419.   DefChrHeight := BiosGetChrHeight;
  1420.   GetDACBlock (@DacPalette,0,256)      {save current vga palette}
  1421. end;
  1422.  
  1423. {
  1424. Menu.
  1425. }
  1426.  
  1427. procedure TCyberGraph.InitMenuBar;
  1428.  
  1429. var
  1430.  
  1431.   R : TRect;
  1432.  
  1433. begin
  1434.   GetExtent (R);
  1435.   R.B.Y := R.A.Y+1;
  1436.   MenuBar := New (PMenuBar,Init (R,NewMenu (
  1437.     NewSubMenu ('~F~ile',hcFile,NewMenu (
  1438.     NewSubMenu ('~L~oad',hcLoadFile,NewMenu (
  1439.       NewItem ('~F~ont...','F3',kbF3,cmLoadFont,hcLoadFile,
  1440.       NewItem ('~P~CX...','Shift+F3',kbShiftF3,cmLoadPCX,hcLoadFile,
  1441.       NewItem ('~C~onfig...','Ctrl+F3',kbCtrlF3,cmLoadConfig,hcLoadFile,
  1442.       nil)))),
  1443.     NewSubMenu ('~S~ave',hcSaveFile,NewMenu (
  1444.       NewItem ('~F~ont...','F2',kbF2,cmSaveFont,hcSaveFile,
  1445.       NewItem ('~P~CX...','Shift+F2',kbShiftF2,cmSavePCX,hcSaveFile,
  1446.       NewItem ('~C~onfig...','Ctrl+F2',kbCtrlF2,cmSaveConfig,hcSaveFile,
  1447.       nil)))),
  1448.       NewLine (
  1449.       NewItem ('~V~iew doc','',kbNoKey,cmViewDoc,hcViewDoc,
  1450.       NewItem ('~A~bout','',kbNoKey,cmAbout,hcAbout,
  1451.       NewLine (
  1452.       NewItem ('E~x~it','Alt+X',kbAltX,cmQuit,hcExit,
  1453.       nil)))))))),
  1454.     NewSubMenu ('~G~raphics',hcGraphics,NewMenu (
  1455.       NewItem ('~L~ines','',kbNoKey,cmLines,hcLines,
  1456.       NewItem ('~E~llipses','',kbNoKey,cmEllipses,hcEllipses,
  1457.       NewItem ('~R~ectangles','',kbNoKey,cmRectangles,hcRectangles,
  1458.       NewItem ('Line ~g~raph','',kbNoKey,cmLineGraph,hcLineGraph,
  1459.       NewItem ('Star ~f~ield toggle','',kbNoKey,cmStarField,hcStarField,
  1460.       NewLine (
  1461.       NewItem ('~C~lear','',kbNoKey,cmClrGraphWin,hcClearGraphWin,
  1462.       NewItem ('~S~ize','',kbNoKey,cmWinSize,hcGraphWinSize,
  1463.       nil))))))))),
  1464.     NewSubMenu('~W~indow',hcWindows,NewMenu(
  1465.       StdWindowMenuItems(nil)),
  1466.     NewSubMenu ('~O~ptions',hcOptions,NewMenu (
  1467.       NewItem ('~S~creen...','',kbNoKey,cmScreenOpts,hcScreen,
  1468.       NewItem ('~C~olors...','',kbNoKey,cmColors,hcOColors,
  1469.       NewItem ('~A~djust palette...','',kbNoKey,cmAdjPal,hcAdjustPalette,
  1470.       NewItem ('~D~efault font','F4',kbNoKey,cmRestoreDef,hcDefaultFont,
  1471.       nil))))),nil)))))))
  1472. end;
  1473.  
  1474. {
  1475. Status line.
  1476. }
  1477.  
  1478. procedure TCyberGraph.InitStatusLine;
  1479.  
  1480. var
  1481.  
  1482.   R : TRect;
  1483.  
  1484. begin
  1485.   GetExtent (R);
  1486.   R.A.Y := R.B.Y-1;
  1487.   StatusLine := New (PStatusLine,Init(R,
  1488.     NewStatusDef (0,$FFFF,
  1489.       NewStatusKey ('~F1~ Help', kbF1, cmHelp,
  1490.       NewStatusKey ('~Alt+F3~ Close',kbAltF3,cmClose,
  1491.       NewStatusKey ('~Alt+X~ Exit',kbAltX,cmQuit,
  1492.       NewStatusKey ('',kbF2,cmSaveFont,
  1493.       NewStatusKey ('',kbF3,cmLoadFont,
  1494.       NewStatusKey ('',kbShiftF2,cmSavePCX,
  1495.       NewStatusKey ('',kbShiftF3,cmLoadPCX,
  1496.       NewStatusKey ('',kbCtrlF2,cmSaveConfig,
  1497.       NewStatusKey ('',kbCtrlF3,cmLoadConfig,
  1498.       NewStatusKey ('',kbF4,cmRestoreDef,
  1499.       NewStatusKey ('',kbCtrlF5,cmResize,
  1500.       NewStatusKey ('',kbF10,cmMenu,
  1501.       nil)))))))))))),nil)))
  1502. end;
  1503.  
  1504. {
  1505. Message when safety pool is cut into.
  1506. }
  1507.  
  1508. procedure TCyberGraph.OutOfMemory;
  1509.  
  1510. begin
  1511.   MessageBox (#3'Not enough memory available to complete operation.  Try closing some windows!',
  1512.   nil,mfError+mfOkButton)
  1513. end;
  1514.  
  1515. {
  1516. Load desk top from stream.
  1517. }
  1518.  
  1519. procedure TCyberGraph.LoadDesktop (var S : TStream);
  1520.  
  1521. var
  1522.  
  1523.   Pal : PString;
  1524.  
  1525. begin
  1526.   Pal := S.ReadStr;
  1527.   if Pal <> nil then
  1528.   begin
  1529.     Application^.GetPalette^ := Pal^;
  1530.     DoneMemory;
  1531.     DisposeStr (Pal)
  1532.   end
  1533. end;
  1534.  
  1535. {
  1536. Store desk top on stream.
  1537. }
  1538.  
  1539. procedure TCyberGraph.StoreDesktop(var S: TStream);
  1540.  
  1541. var
  1542.  
  1543.   Pal: PString;
  1544.  
  1545. begin
  1546.   Pal := @Application^.GetPalette^;
  1547.   S.WriteStr (Pal)
  1548. end;
  1549.  
  1550. {
  1551. If VGA is present then start TV app else print error message.
  1552. }
  1553.  
  1554. var
  1555.  
  1556.   CFApp : TCyberGraph;
  1557.  
  1558. begin
  1559.   if VGACardActive then
  1560.   begin
  1561.     CFApp.Init;
  1562.     SysErrorFunc := AppSystemError;
  1563.     CFApp.Run;
  1564.     CFApp.Done
  1565.   end
  1566.   else
  1567.     PrintStr (#13#10'VGA display required to run CyberGraph!'#13#10);
  1568. end.
  1569.